#!/usr/bin/perl
use strict;
use XML::Simple;
use Data::Dumper;

package main;

require UI;
use subs qw(output debug);

my $xml = new XML::Simple;
my $all_data = $xml->XMLin("inter.xml", forcearray=>['phrase','state','transition','array'], keyattr=>['name']);
my $to_choose = 0; #assuming the initial state is never chooseitem
my $ball;
my $memory;
my $already_gathered_data;

sub interaction
{
	my ($ball2, $wojak) = @_;
	$ball = $ball2; #that's stupid, I know. It's 1.52AM right now and I just want $ball to be a global variable.
	my $data = $all_data->{interaction}->{$ball}; #that's the only thing relevant
	get_data($ball,$data);
	my $state = "start";
	$state = $data->{starting_state} if $data->{starting_state};

	my $inv = $wojak->{inv} if $wojak ne '';

        output; output "--------",2;

	if ($data->{req} ne '' and  not grep {$_ eq $data->{req}} @$inv)  # we can only talk to someone if we have a specific item - todo: document this feature
	{
		output ($data->{phrase}->{noaccess}->{content},1);
		return;
	}

	while ( 1 )
	{
		debug "STATE: $state";
		my $next_state = get_next_state($state,'',$data,$wojak, $all_data);
		$state = $next_state unless $next_state eq '';
		last if $state eq 'quit';       # special state "quit" - ends the interaction
		if ( $to_choose )
		{ 
				$state = get_next_state($state, item_selection(@$inv), $data, $wojak, $all_data);
				next;
		}
		my @disp = split(/,/,$data->{state}->{$state}->{content});
		my @options;
		foreach (@disp)
		{
				return 1 if $_ =~ /quit/;
				if ( $_ =~ m/select/ )
				{
					$_ =~ s/select\(//g;
					$_ =~ s/\)//g;
					@options = split(/\|/,$_);
					foreach my $index (0..$#options)
					{
						next unless $options[$index] =~ m/^@/;
						splice @options, $index, 1, @{$memory->{$ball}->{array}->{substr($options[$index],1)}};
					}
					push @options, "qu";
					my $counter = 1;
					foreach(@options)
					{
						if ( $_ =~ /it/ )
						{
							output "$counter. Use Item";
						}
						elsif ( $_ =~ /qu/ )
						{
							output "$counter. Quit";
						}
						else
						{
							output "$counter. ".$data->{phrase}->{$_}->{content};
						}
						$counter++;
					}
					output
				}
				else
				{
					my $to_print = $data->{phrase}->{$_}->{content};
					while ( $to_print =~ m/(.*)\${([^}]*)}(.*)/g )
					{
						$to_print = $1 . $memory->{$ball}->{variable}->{$2} . $3;
					}
					output $to_print,1;
				}
		}

		my $in = get_input($#options+1);   #MARKER
		my $selection = @options[$in-1];

                $in eq "t" and talk($wojak,$data,$ball);
                $in =~ /^go to ([\w\s\.]*)/ and $wojak->go($all_data, $ball, $1);
                $in =~ /^talk to ([\w\s\.]*)/ and $wojak->talkto($all_data, $ball, $1);

                    last if ( $selection =~ /qu/ );

		$selection = item_selection(@$inv) if $selection =~ /it/;
		$state = get_next_state($state, $selection, $data, $wojak, $all_data);
		if ($state eq '') #Will we ever reach that? - now that you changed the chooseitem thingy again, it's probably useless, kurwa.
		{
		   $state = "chooseitem";
		   $state = get_next_state($state, $selection, $data, $wojak, $all_data);
		}
	}
	return 1;
}

sub get_next_state
{
	my ($state, $selection, $data, $self, $all_data) = @_;
	my $inv = $self->{inv};
	return "quit" if $selection eq 'qu';
	foreach(@{$data->{transition}})   # so this is where the transitions are checked, obviously
	{
		my @args = split(/,/,$_);
		next unless $state eq @args[0] or @args[0] eq 'chooseitem'; # only transitions that have the current state set as starting state are being looked at
		if ( does_fit($selection,@args[1]) or (@args[1] =~ /^it$/ and $selection ne '') ) #remember that we agreed that "it" alone will be the written as last so there's no problem there
		{
			fourth_argument(@args[3], $inv, $state, $data) if @args[3]; #the fourth transition field is for all kinds of stuff to happen - so far can print phrases, change the mood of the character we are talking to, change the starting state of any character, lose and get items
			if ( @args[2] eq 'chooseitem' ) #old style
			{
				$to_choose = 1;
				return $state;
			}
			$to_choose = 0;
			return @args[2];   #and this is the most important thing happening in this method, i.e. returning the state
			last;
		}
	}
	
	if ( $selection =~ m/^it\(/ ) #if we (still) don't know what to do with the item the user selected; this equals to the "it" in the second argument.
	{
		$to_choose = 1;
		output $data->{phrase}->{cantuse}->{content} . "\n";
		return $state;
	}

	return '';  #this should probably throw an error or at least produce an entry in the error log, no?
}

sub fourth_argument
{
	my ($argument, $inv, $state, $data) = @_;
	my @things_to_do = split(/--/,$argument);
	foreach my $thing (@things_to_do)
	{
		if ( $thing =~ m/it\(/ )   # this is the part about adding/scrapping things from the inventory
		{
			$thing = substr $thing, 3, -1;
			my @temp = split /:/, $thing;
			my @give = split /\|/,@temp[0];
			my @take = split /\|/,@temp[1];
			foreach my $item (@take)
			{
				next unless $item;
				my @arr = item_to_array($item);
				my $name = @arr[1];
				my $did_remove = 0;
				foreach my $index (0 .. scalar(@$inv)-1)
				{
					if ( @$inv[$index] =~ m/(^.*_)?($name)$/ )
					{
						my @arr2 = item_to_array(@$inv[$index]);
						splice @$inv, $index, 1;
						last if @arr2[0] - @arr[0] < 0;
						$did_remove = 1;
						push @$inv, (@arr2[0] - @arr[0]) . "_" . $name if @arr2[0] ne @arr[0];
						last;
					}
				}
				$item =~ s/_/ /g;
				if ( not $did_remove )
				{
					output "You can't complete this transaction because you don't have $item.";
					return $state;
				}
				$item and output "You lost $item!";
			}
			foreach my $item (@give)
			{
				my @arr = item_to_array($item);
				my $name = @arr[1];
				my $did_add = 0;
				foreach my $index (0 .. scalar(@$inv)-1)
				{
						if ( @$inv[$index] =~ m/^(.*_)?($name)$/ )
						{
								my @arr2 = item_to_array(@$inv[$index]);
								splice @$inv, $index, 1;
								push @$inv, (@arr2[0] + @arr[0]) . "_" . $name;
								$did_add = 1;
								last;
						}
				}
				push @$inv, $item if not $did_add;
				$item =~ s/_/ /g;
				$item and output "You got $item!";
			}
			next;
		}
		if ( $thing =~ m/^start\(/ ) #changing a starting state of a ball
		{
			$thing = substr $thing, 6, -1;
			my @arg = split /\|/, $thing;
			$all_data->{interaction}->{@arg[0]}->{starting_state} = @arg[1];
			next;
		}
		if ( $thing =~ m/^mood\(/ ) #changing the mood of a character
		{
			$data->{mood} = substr $thing, 5, -1;
			next;
		}
		if ( $thing =~ m/^loc\(/ ) #changing the location of a character, loc(char:loc) or loc(loc) for the current character
		{
			if ( $thing =~ /loc\(([\w\s\.\d]*):([\w\s\.\d]*)\)/ )
			{
				$all_data->{interaction}->{$1}->{location} = $2;   
			}
			else
			{
				$data->{location} = substr $thing, 4, -1;
			}
			next;
		}
		if ( $thing =~ m/^del\(/ ) #deleting an element from an array
		{
			$thing = substr $thing, 5;
			my ($array_name, $to_delete) = split /\|/, $thing;
			$to_delete = substr $to_delete, 0, -1;
			my $array = $memory->{$ball}->{array}->{$array_name};
			foreach my $i (0..scalar(@$array)-1)
			{
				next unless @$array[$i] eq $to_delete;
				print "DELETING " . @$array[$i] . "\n";
				delete @$array[$i] if $i;
				shift @$array unless $i;
				last;
			}
			next;
		}
		if ( $thing =~ m/^\${([^}]*)}$/ ) #assigning a variable
		{
			$thing = $1;
			my ($name, $value) = split /:=/, $thing;
			$memory->{$ball}->{variable}->{$name} = $value;
		}
		output $data->{phrase}->{$thing}->{content};
	}
}

sub item_selection
{
    my (@inv) = @_;
	output "Select an item: \n";
	my $counter = 1;
	foreach (@inv)
	{
		my $copy = $_ ;
		$copy=~ s/_/ /;
		output $counter . ". " . $copy;
		$counter++;
	}
	output "$counter. Quit",1;
	my $in = get_input($counter);
	if ( $in eq $counter )
	{
		$to_choose = 0;
		return "qu";
	}
	return "it(".@inv[$in-1] . ")";
}

sub get_input
{
        my ($upper_limit) = @_;
        my $in;
        output "What say or do?>",2;


        while ( 1 )
        {
                $in = &input;
                chop($in);chop($in);
                $in =~ /^\d+$/ and $in > 0 and $in <= $upper_limit and last;
                if($in =~ /\w/) 
                {
                   $in eq "t" and last;
                   $in =~ "go to" and last;
                   $in =~ "talk to" and last;
                }
                output "Please enter a legal option: ",2;

        }
        output; output "--------",1;
        return $in;
}

sub item_to_array
{
	my ($item) = @_;
	my @arr = split /_/, $item;
	return @arr if scalar(@arr) eq 2;
	return (1, @arr[0]);
}

sub does_fit
{
	my ($given, $needed) = @_;
	my @conditions = split / AND /, $needed;
	foreach (@conditions)
	{
		if ( $_ =~ m/\${(.*)\?\=(.*)}/ )
		{
			return 0 unless $memory->{$ball}->{variable}->{$1} eq $2;
			next;
		}
		next if $given eq $_;
		return 0 if $given !~ m/^it\(/ and $_ !~ m/^it\(/;
		$given = substr $given, 3, -1;
		$_ = substr $_, 3, -1;
		my @a = item_to_array($given);
		my @b = item_to_array($_);
		return 0 unless @a[1] eq @b[1] and @a[0] >= @b[0];
	}
	return 1;
}

sub demo
{
  output "Talk to Germany or Lena? ";
  my $in = &input;
  chomp($in);
  interaction($in);
  #output "Inventory: " . join(", ", @inv);
  output "Finished conversation";
}  

sub print_characters
{
        my ($here) = @_;
        my @uselessfillers=("quite ","kind of ", "pretty ");
    my $charcount=0;
    my @places;
        foreach my $thatguy (keys %{$all_data->{interaction}})
    {
                next unless $all_data->{interaction}->{$thatguy}->{"location"} eq $here;
    

        if ($all_data->{interaction}->{$thatguy}->{"type"} eq "place")
        {
          push @places, $thatguy;
          next;
        }
        $charcount++;
        $charcount==2 and my $end=" too";
        my $pronoun="He";
        $all_data->{interaction}->{$thatguy}->{sex}=~"female" and $pronoun="She";
                $all_data->{interaction}->{$thatguy}->{plural} and $pronoun="They";
                my $present_simple = "s" unless $all_data->{interaction}->{$thatguy}->{plural};
                my $be = "is";
                $all_data->{interaction}->{$thatguy}->{plural} and $be = "are";
        my $uselessfiller="";
        if(rand()>0.8)
        {
            my $element=int(rand($#uselessfillers+1));
            $uselessfiller=$uselessfillers[$element];
            splice(@uselessfillers, $element, 1);
        }
        my $mood="";
        $mood=" $pronoun seem$present_simple to be $uselessfiller".$all_data->{interaction}->{$thatguy}->{mood}."." if $all_data->{interaction}->{$thatguy}->{mood} ne '';
        $::cgi or output "$thatguy $be here$end.$mood",1;
        $::cgi and return "$thatguy $be here$end.$mood";
    }
    
    my $placecount=0;
    my $places_to_print;
    for my $place (@places)
    {

       $places_to_print="In the distance you can see $place" if $placecount==0&&$#places>0;
       $places_to_print="In the distance you can see $place." if $placecount==0&&$#places==0;
       $places_to_print.=", $place" if $placecount>0&&$placecount<$#places;
       $places_to_print.=" and $place." if $placecount>0&&$placecount==$#places;
       $placecount++;

    }
    $::cgi or output $places_to_print,1 if $places_to_print;
    $::cgi and return $places_to_print if $places_to_print;
}

sub talk
{
	my ($self, $data, $here) = @_;
	!$here and $here = $self->get_loc($data);
	my @guys = ();#@{$data->{region}->{$here}->{character}};
	my @places = ();
	foreach (keys %{$all_data->{interaction}})
	{
		push @guys, $_ if $all_data->{interaction}->{$_}->{location} eq $here and $all_data->{interaction}->{$_}->{type} ne 'place';
		push @places, $_ if $all_data->{interaction}->{$_}->{location} eq $here and $all_data->{interaction}->{$_}->{type} eq 'place';
	} #@guys now holds the names of all things whose location = $here
	
	if ( scalar(@guys) == 0 )
	{
		output "There is no one you can talk to in here!\n";
		return output;
	}
	if ( scalar(@guys) == 1 )
	{
		interaction(@guys[0], $self);
		return;
	}

	output "Who do you want to talk to?> ",2;
	my $in = &input;
	chomp($in);

	for my $guy (@guys)
	{
	   $guy=~$in and interaction($in, $self) and return 1;
	}

	output "$in is not here.";
	return 0;
}

sub get_data
{
	my ($ball, $data) = @_;
	return 1 if $already_gathered_data->{$ball};
	$already_gathered_data->{$ball} = 1;
	foreach (@{$data->{array}})
	{
		my ($array_name, $value) = split /:/, $_;
		@{$memory->{$ball}->{array}->{$array_name}} = split /;/, $value;
	}
}



1;